Milestone 2 Final
## Entity Code Year avgBirthWomen childDeath100LiveBirths democracyIndex
## 1 United States USA 1933 2.012 NA 0.546
## 2 United States USA 1934 2.072 NA 0.547
## 3 United States USA 1935 2.038 NA 0.559
## 4 United States USA 1936 2.007 NA 0.559
## 5 United States USA 1937 2.038 NA 0.557
## popNoEduc popBasicEduc avgChildbearingAge gpdCapita population
## 1 NA NA 27.97 NA 122717780
## 2 NA NA 27.84 NA 123580010
## 3 NA NA 27.71 NA 124448298
## 4 NA NA 27.60 NA 125322686
## 5 NA NA 27.44 NA 126203219
## familyPlanSatisfied notPregNoContraception litRate govnSpendEduc
## 1 NA NA NA NA
## 2 NA NA NA NA
## 3 NA NA NA NA
## 4 NA NA NA NA
## 5 NA NA NA NA
## womenEmpowermentIndex marriageRate
## 1 0.407 8.7
## 2 0.407 10.3
## 3 0.411 10.4
## 4 0.396 10.7
## 5 0.396 11.3
Visualization 1
df_education_rates <- df %>%
filter(!is.na(avgBirthWomen), !is.na(popNoEduc), !is.na(popBasicEduc)) %>%
mutate(totalEduPop = popNoEduc + popBasicEduc) %>%
mutate(
noEduRate = avgBirthWomen * (popNoEduc / totalEduPop),
basicEduRate = avgBirthWomen * (popBasicEduc / totalEduPop)
) %>%
select(Year, noEduRate, basicEduRate) %>%
pivot_longer(
cols = c(noEduRate, basicEduRate),
names_to = "EducationLevel",
values_to = "ApproxBirthRate"
)
ui <- fluidPage(
titlePanel("Birth Rates by Education Level Over Time (U.S.)"),
sidebarLayout(
sidebarPanel(
sliderInput("yearRange",
"Select Year Range:",
min = min(df_education_rates$Year),
max = max(df_education_rates$Year),
value = c(min(df_education_rates$Year), max(df_education_rates$Year)),
step = 1,
sep = ""),
checkboxGroupInput("eduLevels",
"Select Education Level(s):",
choices = list("No Education" = "noEduRate", "Basic Education" = "basicEduRate"),
selected = c("noEduRate", "basicEduRate"))
),
mainPanel(
plotlyOutput("birthRatePlot")
)
)
)
server <- function(input, output) {
filteredData <- reactive({
df_education_rates %>%
filter(Year >= input$yearRange[1], Year <= input$yearRange[2]) %>%
filter(EducationLevel %in% input$eduLevels)
})
output$birthRatePlot <- renderPlotly({
p <- ggplot(filteredData(), aes(x = Year, y = ApproxBirthRate, color = EducationLevel)) +
geom_line(size = 1.2) +
geom_point(size = 2) +
scale_color_manual(
values = c(
"noEduRate" = "#3498db", # Blue
"basicEduRate" = "#e74c3c" # Red
),
labels = c(
"noEduRate" = "No Education",
"basicEduRate" = "Basic Education"
)
) +
labs(
x = "Year",
y = "Estimated Births per Woman",
color = "Education Level"
) +
theme_minimal()
ggplotly(p)
})
}
#shinyApp(ui, server)Visualization 2
mergedWorld = df[18:87,]
#keeps all columns but only keeps rows with GDP value
ui <- fluidPage(
titlePanel("GDP vs Birthrates Comparison"),
fluidRow(
column(6, plotOutput("plot1", brush = brushOpts(id = "sharedBrush", resetOnNew = FALSE))),
column(6, plotOutput("plot2", brush = brushOpts(id = "sharedBrush", resetOnNew = FALSE)))
)
)
server <- function(input, output, session) {
selectedYears <- reactiveVal(numeric(0))
observeEvent(input$sharedBrush, {
brushed <- brushedPoints(mergedWorld, input$sharedBrush, xvar = "Year", yvar = NULL)
selectedYears(brushed$Year)
})
output$plot1 <- renderPlot({
highlightYears <- selectedYears()
mergedWorld %>%
mutate(highlight = Year %in% highlightYears) %>%
ggplot(aes(x = Year, y = avgBirthWomen)) +
geom_point(aes(alpha = highlight, size = highlight)) +
scale_alpha_manual(values = c("TRUE" = 1, "FALSE" = 0.5), guide = "none") +
scale_size_manual(values = c("TRUE" = 3, "FALSE" = 1), guide = "none") +
labs(title = "Birth Rates Over Time", y = "Average birth rate per woman")
})
output$plot2 <- renderPlot({
highlightYears <- selectedYears()
mergedWorld %>%
mutate(highlight = Year %in% highlightYears) %>%
ggplot(aes(x = Year, y = gpdCapita)) +
geom_point(aes(alpha = highlight, size = highlight)) +
scale_alpha_manual(values = c("TRUE" = 1, "FALSE" = 0.3), guide = "none") +
scale_size_manual(values = c("TRUE" = 3, "FALSE" = 1), guide = "none") +
labs(title = "GDP Per Capita Over Time", y = "GDP per Capita")
})
}
#shinyApp(ui, server)Visualization 3
# read and clean data
# data = read_csv("data/mergedWorldDataset.csv", show_col_types = FALSE)
data = df |>
filter(!is.na(avgChildbearingAge), !is.na(womenEmpowermentIndex), !is.na(marriageRate))|>
select(Year, avgChildbearingAge, womenEmpowermentIndex, marriageRate)
# create layout with slider for year, and choices for y-axis metrics
ui = fluidPage(
titlePanel("Women's Empowerment Data Over Time (U.S)"),
sidebarLayout(
sidebarPanel(
sliderInput("yearRange", "Select Year Range", min(data$Year), max(data$Year),
value = c(min(data$Year), max(data$Year)),step = 1, sep = ""),
selectInput("yMetric", "Select Y-Axis Metric: ",
choices = c("Average Childbearing Age" = "avgChildbearingAge","Marriage Rate" = "marriageRate"),
selected = "avgChildbearingAge")),
mainPanel(plotlyOutput("barLinePlot"))
)
)
# server that displays graph
server = function(input, output) {
output$barLinePlot = renderPlotly({
filtered_data = data |>
filter(Year >=input$yearRange[1], Year <= input$yearRange[2]) |>
mutate(
selectedMetric = .data[[input$yMetric]],
emp = womenEmpowermentIndex
)
plot = ggplot(filtered_data, aes(x = Year)) +
geom_col(aes(y = selectedMetric, fill = emp), width = 0.5) +
scale_fill_gradient(low = "lightblue", high = "navy")+
scale_x_continuous(breaks = seq(min(filtered_data$Year), max(filtered_data$Year), 5)) +
labs(
x = "Year",
y = ifelse(input$yMetric == "avgChildbearingAge", "Average Childbearing Age", "Marriage Rate"),
fill = "Empowerment Index",
title = "Selected Metric vs. Women's Empowerment Over Time"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggplotly(plot)
})
}
# run shiny app
#shinyApp(ui = ui, server = server)Visualization 4
# Focused variables
data_vars <- df %>%
select(
Year,
avgBirthWomen,
democracyIndex,
gpdCapita,
womenEmpowermentIndex,
population,
marriageRate,
popNoEduc,
popBasicEduc
) %>%
arrange(Year)Plotting Functions
# plotting functions
make_plt1 <- function(filtered_data, selected_var) {
ggplot(filtered_data, aes(x = Year)) +
geom_line(aes(y = avgBirthWomen), color = "blue") +
geom_line(aes(y = filtered_data[[selected_var]] * 10), color = "red") +
scale_y_continuous(
name = "Births per Woman",
sec.axis = sec_axis(~ . / 10, name = "Democracy Index")
) +
labs(
title = paste(
"Trends in Births per Woman and",
ifelse(selected_var ==
"democracyIndex",
"Democracy Index",
"Women's Empowerment"),
"Over Time"),
x = ""
) +
theme_bw() +
theme(
axis.title.y = element_text(color = "blue", margin = margin(r = 15)),
axis.title.y.right = element_text(color = "red", margin = margin(l = 15))
)
}
make_plt2 <- function(filtered_data) {
ggplot(filtered_data, aes(democracyIndex, womenEmpowermentIndex)) +
geom_smooth(se = FALSE) +
labs(
title = "Association Between Democracy Index and Women's Empowerment Index",
x = "Democracy Index (0-100%)",
y = "Women's Empowerment Index (0-100%)"
) +
theme_bw()
}
make_plt3 <- function(filtered_data, selected_var) {
ggplot(filtered_data, aes_string(x = selected_var, y = "avgBirthWomen")) +
geom_smooth(se = FALSE) +
labs(title = paste(
ifelse(selected_var == "democracyIndex", "Democracy Index", "Women's Empowerment"),
"vs. Average Births per Woman"),
x = ifelse(selected_var == "democracyIndex", "Democracy Index (0-100%)",
"Women's Empowerment Index (0-100%)"),
y = "Average Births per Woman"
) +
theme_bw()
}Shiny App
# interface design
ui <- fluidPage(
sliderInput("years", "Select Years",
min = min(data_vars$Year),
max = max(data_vars$Year),
value = c(min(data_vars$Year), max(data_vars$Year)),
sep = ""
),
selectInput("var", "Pick a Variable",
choices = c("Democracy Index" = "democracyIndex",
"Women's Empowerment" = "womenEmpowermentIndex"),
multiple = FALSE),
fluidRow(
column(6, plotOutput("linePlot")),
column(6, plotOutput("linePlot3"))
),
plotOutput("linePlot2")
)
server <- function(input, output) {
selection <- reactive({
data_vars %>%
filter(Year >= input$years[1], Year <= input$years[2])
})
output$linePlot <- renderPlot(make_plt1(selection(), input$var))
output$linePlot2 <- renderPlot(make_plt2(selection()))
output$linePlot3 <- renderPlot(make_plt3(selection(), input$var))
}
#shinyApp(ui, server)